home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.001 / GOLDDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  36KB  |  1,163 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                     {*********************************}
  12.                     {**       Unit:   GOLDDIR       **}
  13.                     {*********************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDDIR; {++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GOLDDIR}
  19.    {$DEFINE GOLDDIR}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. {Development notes
  25.        1.01a    07/10/95    permitted compilation with TP6
  26. }
  27.  
  28. uses DOS, CRT, GoldHard, GoldMisc, GoldKey, GoldFast, GoldWin, GoldIO,
  29.      GoldIO2, Goldio3, GoldLink, GoldStr, GoldTint, GoldDate, GoldList;
  30.  
  31.  
  32. type
  33.    DirTints = Array [DirPathInfo..DirFileInfo] of byte;
  34.  
  35.    PromptHelpHook = procedure;
  36.  
  37.    DirSet = record
  38.       ExistsOnly: boolean;
  39.       LastECode: integer;
  40.       ScrlFldVar: PathStr;
  41.       FileFldVar: integer;
  42.       DirFldVar: integer;
  43.       TypeFldVar: integer;
  44.       DrvFldVar: integer;
  45.       FilLst, DirLst,
  46.       TypLst, DrvLst: StringLL;
  47.       InputField: string;
  48.       Attr: word;
  49.       SavedPath,
  50.       DefaultMask: PathStr;
  51.       Col: DirTints;
  52.       {List-related}
  53.       LX1,LX2,LY1,LY2,
  54.       LWinStyle: byte;
  55.       AllowDirChange: boolean;
  56.       AllowDrvChange: boolean;
  57.       NameList: DoubleLLPtr;
  58.       SortbyName: boolean;
  59.       LastAction: gAction;
  60.       EMsgFunc: ErrMsgFunc;
  61.       {text}
  62.       PromptFileHelp: PrompthelpHook;
  63.       StrPromptFileTitle: string[60];
  64.       StrPromptDirTitle: string[40];
  65.       OpenButStr: strButton;
  66.       OpenHK: word;
  67.       NotReadyTitle: string [30];
  68.       NotReadyMsgA: string [30];
  69.       NotReadyMsgB: string [60];
  70.       NoExistTitle: string [30];
  71.       NoExistText: string [60];
  72.       ParentStr: string[30];
  73.       SubDirStr: string[30];
  74.       RootStr: string[30];
  75.       NoFilesStr: string[30];
  76.       RootNameStr: string[12];
  77.       DriveStr: string[20];
  78.       SortingStr: string[30];
  79.    end;
  80.  
  81. function  PromptFile(FullFilename:PathStr): StrScreen;
  82. function  FileList(FullFilename:PathStr; Tit:StrScreen): StrScreen;
  83. function  PromptDir(FullFilename:PathStr;Cmt:StrScreen): StrScreen;
  84. function  LastDirError: integer;
  85. procedure AssignDirHelpHook(PFHook: PrompthelpHook);
  86. procedure RemoveDirhelpHook;
  87.  
  88. {$IFDEF TTT5}
  89. function Display_Directory(DIRFULLFileName: StrScreen;var Retcode:integer): StrScreen;
  90. {$ENDIF}
  91.  
  92. var
  93.    DirVars: DirSet;
  94.  
  95. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  96. var
  97.    StartPathStr,
  98.    LastMaskStr: PathStr;
  99.    LastDir: DirStr;
  100.    LastFullFileName: PathStr;
  101.    LastFld4Val: PathStr;
  102.    LastDrv: byte;
  103.    CurrFld: integer;
  104.    Action: gAction;
  105.    SavedDrv,
  106.    SavedDir: integer;
  107.    CDirLine: byte;
  108.  
  109.                       {******************************}
  110.                       {**  Miscellaneous Routines  **}
  111.                       {******************************}
  112.  
  113. {$IFOPT F-}
  114.    {$DEFINE FOFF}
  115.    {$F+}
  116. {$ENDIF}
  117. function DirEMsg(ECode:integer): string;
  118. {}
  119. begin
  120.    case Ecode of
  121.       0: exit;
  122.       1: DirEMsg := 'Insufficient memory to display files';
  123.       2: DirEMsg := 'Passed parameter can''t be located';
  124.       3: DirEMsg := 'Unable to reset original path';
  125.       4: DirEMsg := 'Error testing selected directory';
  126.       else
  127.          DirEMsg := 'Internal directory error';
  128.    end; {case}
  129. end; { DirEMsg }
  130. {$IFDEF FOFF}
  131.    {$F-}
  132.    {$UNDEF FOFF}
  133. {$ENDIF}
  134.  
  135. procedure DirSetError(ECode:integer);
  136. {}
  137. {$IFOPT D+}
  138. var Msg: string;
  139. {$ENDIF}
  140. begin
  141.    DirVars.LastEcode := ECode;
  142. {$IFOPT D+}  {if debug active display an error message and terminate}
  143.    if Ecode <> 0 then
  144.    begin
  145.       str(Ecode,Msg);
  146.       Msg := Msg+': '+DirVars.EMsgFunc(Ecode);
  147.       SetWinIgnore(true);
  148.       if PromptCustom(' GoldDir Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
  149.          Halt;
  150.    end;
  151. {$ENDIF}
  152. end; {DirSetError}
  153.  
  154. function LastDirError: integer;
  155. {}
  156. begin
  157.    LastDirError := DirVars.LastECode;
  158. end; { LastDirError }
  159.  
  160. function RealDriveID(ListID: byte): byte;
  161. {}
  162. begin
  163.    RealDriveID := ListID + ord((ListID <> 1) and IsPhantom);
  164. end; { RealDriveID }
  165.  
  166. procedure AssignDirHelpHook(PFHook: PrompthelpHook);
  167. {}
  168. begin
  169.    DirVars.PromptFileHelp := PFHook;
  170. end; {AssignDirHelpHook }
  171.  
  172. procedure NoRemoveDirhelpHook;
  173. begin
  174.    {abstract}
  175. end; { NoRemoveDirhelpHook }
  176.  
  177. procedure RemoveDirhelpHook;
  178. {}
  179. begin
  180.    DirVars.PromptFileHelp := NoRemoveDirhelpHook; {1.01a}
  181. end; { RemoveDirhelpHook }
  182.  
  183. function FileDetailsStr(Fname:PathStr;PadIt: boolean): PathStr;
  184. {}
  185. var
  186.    SrchRec: SearchRec;
  187.    DT: DateTime;
  188.    Secs: longint;
  189. begin
  190.    findfirst(Fname,AnyFile,SrchRec);
  191.    UnPackTime(SrchRec.Time,DT);
  192.    with DT do
  193.    begin
  194.       Secs := TimetoLong(Hour,Min,Sec);
  195.       if PadIt then
  196.          FileDetailsStr := PadLeft(SrchRec.Name,12,' ')+' '+
  197.                          PadLeft(IntToStr(SrchRec.Size),12,' ')+' '+
  198.                          FancyDateStr(GregToJul(DT.Month,
  199.                                       DT.Day,DT.Year),false,false)+'  '+
  200.                          LongToTimeStr(Secs,HHMM,true,false)
  201.       else
  202.          FileDetailsStr := SrchRec.Name+' '+
  203.                            IntToStr(SrchRec.Size)+' '+
  204.                            FancyDateStr(GregToJul(DT.Month,
  205.                                       DT.Day,DT.Year),false,false)+' '+
  206.                            LongToTimeStr(Secs,HHMM,true,false)
  207.  
  208.    end;
  209. end; { FileDetailsStr }
  210.  
  211. procedure RefreshLongDesc;
  212. {Writes the file or directory details in the directory window}
  213. begin
  214.    with DirVars do
  215.    begin
  216.       {erase and update current directory}
  217.       WriteAT(3,14,Col[DirPathInfo],Replicate(50,' '));
  218.       WriteAT(3,14,Col[DirPathInfo],LastDir);
  219.       {erase and if appropriate, update file information}
  220.       WriteAT(3,15,Col[DirFileInfo],Replicate(50,' '));
  221.       if (StrLLGetStr(FilLst,FilLst.ActiveNode) <> LinkVars.NoFilesFound) then
  222.          WriteAT(3,15,Col[DirFileInfo],FileDetailsStr(SlashedDirectory(LastDir)+StrLLGetStr(FilLst,FileFldVar),true));
  223.    end;
  224. end; { RefreshLongDesc }
  225.  
  226. {$IFOPT F-}
  227.    {$DEFINE FOFF}
  228.    {$F+}
  229. {$ENDIF}
  230. procedure DirLeaveHook(var CurrentField:byte;var Refresh:byte);
  231. {}
  232. begin
  233.   if CurrentField = 1 then
  234.    begin
  235.       with DirVars do
  236.       begin
  237.          if (LastMaskStr <> ScrlFldVar) then
  238.          begin
  239.             if (length(ScrlFldVar) > 0) then
  240.             begin
  241.                if ((pos('*',ScrlFldVar) <> 0)
  242.                   or (pos('?',ScrlFldVar) <> 0)) then
  243.                begin
  244.                   LastMaskStr := ScrlFldVar;
  245.                   if (LoadWithFiles(FilLst,LastDir,LastMaskStr,Attr) = 0) then
  246.                      ListUpDateStrLL(2,FilLst);
  247.                end else
  248.                begin
  249.                   if (pos('*',ScrlFldVar) = 0)
  250.                      and (pos('?',ScrlFldVar) = 0) then
  251.                   Action := Finished;
  252.                end;
  253.                Refresh := RefreshOthers;
  254.                CurrFld := 1;
  255.             end;
  256.          end;
  257.       end;
  258.    end;
  259. end; { DirLeaveHook }
  260.  
  261. procedure DirHindHook(CurrentField:byte;var Refresh:byte);
  262. {}
  263. var
  264.    StartDrv,
  265.    gResult: integer;
  266.    Tmp: string;
  267.    LK: word;
  268.  
  269.     procedure ChangeDrives;
  270.     {}
  271.     begin
  272.        with DirVars do
  273.        begin
  274.           ListUpdateStrLL(3,DirLst);
  275.           if (pos('*',ScrlFldVar) = 0) and (pos('?',ScrlFldVar) = 0) then
  276.              ScrlFldVar := LastMaskStr;
  277.           if ( LoadWithFiles(FilLst,LastDir,ScrlFldVar,DirVars.Attr) = 0 ) then
  278.              ListUpdateStrLL(2,FilLst);
  279.           Refresh := RefreshAll;
  280.           CurrFld := 5;
  281.        end;
  282.     end; { ChangeDrives }
  283.  
  284. begin
  285.    Refresh := RefreshNone;
  286.    case CurrentField of
  287.       0: begin                 { first time thru }
  288.          end;
  289.       1: begin
  290.             CurrFld := 1;
  291.          end;
  292.       2: begin                        { FileListField }
  293.             with DirVars do
  294.             begin
  295.                Tmp := StrLLGetStr(FilLst,FileFldVar);
  296.                if (Tmp = LinkVars.NoFilesFound) then
  297.                   ScrlFldVar := LastMaskStr
  298.                else if (ListLastKey(2) = 540) or (KeyVars.LastKey = 13) then
  299.                   Refresh := EndInput
  300.                else
  301.                begin
  302.                   ScrlFldVar := StrLLGetStr(FilLst,FileFldVar);
  303.                   Refresh := RefreshOthers;
  304.                end;
  305.                CurrFld := 2
  306.             end;
  307.          end; {2}
  308.       3: begin                        { DirectoryListField }
  309.             LK := ListLastKey(3);
  310.             if (KeyVars.LastKey = 13) or (LK = 540) then     {Enter or left double click}
  311.             with DirVars do
  312.             begin
  313.                Tmp := StrLLGetStr(DirLst,DirFldVar);
  314.                if (Tmp <> LinkVars.NoDirectories) then
  315.                begin
  316.                   delete(Tmp,length(tmp),1);    { deletes brackets }
  317.                   delete(Tmp,1,1);
  318.                   {$I-}
  319.                   ChDir(Tmp);
  320.                   gResult := IOResult;
  321.                   {$I+}
  322.                   if gResult <> 0 then
  323.                      exit
  324.                   else
  325.                   begin
  326.                      LastDir := CurrentPathStr;
  327.                      if ( LoadWithDirectories(DirLst,LastDir) = 0 ) then
  328.                      begin
  329.                         ListUpdateStrLL(3,DirLst);
  330.                         if (LoadWithFiles(FilLst,LastDir,LastMaskStr,Attr) = 0) then
  331.                         begin
  332.                            ListUpdateStrLL(2,FilLst);
  333.                            ScrlFldVar := LastMaskStr;
  334.                         end;
  335.                         Refresh := RefreshAll;
  336.                         CurrFld := 3;
  337.                      end;
  338.                   end;
  339.                end;
  340.             end;
  341.          end; {3}
  342.       4: begin                        { FileMaskField }
  343.             with DirVars do
  344.             begin
  345.                Tmp := StrLLGetStr(TypLst,TypeFldVar);
  346.                if ( LastFld4Val <> Tmp ) then
  347.                begin
  348.                   LastFld4Val := Tmp;
  349.                   LastMaskStr := Tmp;
  350.                   if ( LoadWithFiles(FilLst,LastDir,LastFld4Val,DirVars.Attr) = 0 ) then
  351.                      ListUpdateStrLL(2,FilLst);
  352.                   ScrlFldVar := LastMaskStr;
  353.                   Refresh := RefreshAll;
  354.                   CurrFld := 4;
  355.                end;
  356.             end;
  357.          end;
  358.       5: begin              { DriveField }
  359.             with DirVars do
  360.             begin
  361.                if DrvFldVar <> LastDrv then
  362.                begin
  363.                   StartDrv := LastDrv;
  364.                   LastDrv := DrvFldVar;
  365.                   if (LastDrv >= 2) and IsPhantom then
  366.                      inc(LastDrv);
  367.                   SetCurrentDriveTo(DriveChar(LastDrv));
  368.                   LastDir := CurrentPathStr;
  369.                   if ( LoadWithDirectories(DirLst,LastDir) = 0 ) then
  370.                      ChangeDrives
  371.                   else
  372.                   begin
  373.                      Tmp := NotReadyMsgA + DriveChar(LastDrv) +':|' + NotReadyMsgB;
  374.                      repeat
  375.                          if PromptOKCancel(NotReadyTitle,Tmp) = 2 then
  376.                          begin
  377.                             LastDrv := StartDrv;
  378.                             DrvFldVar := LastDrv - ord(IsPhantom and (LastDrv <> 1));
  379.                             LastDrv := DrvFldVar;
  380.                             (*
  381.                             DrvLst.ActiveNode := DrvFldVar;
  382.                             *)
  383.                             SetCurrentDriveTo(DriveChar(RealDriveID(LastDrv)));
  384.                             LastDir := CurrentPathStr;
  385.                             if LoadWithDirectories(DirLst,LastDir) <> 0 then
  386.                                {too bad};
  387.                             Refresh := RefreshCurrent;
  388.                             exit;
  389.                          end;
  390.                      until LoadWithDirectories(DirLst,LastDir) = 0;
  391.                      ChangeDrives;
  392.                   end;
  393.                end;
  394.             end;
  395.          end;  {5}
  396.       6: begin
  397.             CurrFld := 1;
  398.          end;
  399.    end; { case of CurrentField }
  400.    RefreshLongDesc;
  401. end; {DirHindHook}
  402.  
  403. {$IFDEF FOFF}
  404.    {$F-}
  405.    {$UNDEF FOFF}
  406. {$ENDIF}
  407.  
  408. procedure ParseDriveandMask(FullFilename: PathStr; var Path: PathStr);
  409. {Parses FullFilename into the specified path and filemask}
  410. var P: byte;
  411. begin
  412.    FullFileName := SetUpper(FullFileName);
  413.    if FullFileName = '' then
  414.    begin
  415.       P := pos(' ',DirVars.DefaultMask);
  416.       if P = 0 then
  417.          LastMaskStr := DirVars.DefaultMask
  418.       else
  419.          LastMaskStr := copy(DirVars.DefaultMask,1,pred(P));
  420.       Path := CurrentPathStr;
  421.    end else
  422.    begin
  423.       P := LastPos('\',FullFileName);
  424.       if (P = 0) then
  425.       begin
  426.          Path := CurrentPathStr;
  427.          if ((pos('*',FullFileName)=0) and (pos('?',FullFileName)=0)) then
  428.             LastMaskStr := DirVars.DefaultMask
  429.          else
  430.             LastMaskStr := FullFileName;
  431.       end
  432.       else
  433.       begin
  434.          LastMaskStr := copy(FullFileName,succ(P),255);
  435.          if ((pos('*',LastMaskStr)=0) and (pos('?',LastMaskStr)=0)) then
  436.             LastMaskStr := DirVars.DefaultMask;
  437.          Path := copy(FullFileName,1,pred(P));
  438.          if path = '' then
  439.             Path := '\';
  440.       end;
  441.    end;
  442.    DirVars.ScrlFldVar := LastMaskStr;
  443.    LastDir := Path;
  444.    LastFullFileName := '';
  445. end; { ParseDriveandMask }
  446.  
  447. Function PromptFile( FullFilename: PathStr): StrScreen;
  448. {FullFileName includes path name and may include
  449.  additional file masks, space delimited.
  450.          Example:   C:\SUB1\SUB2\*.PAS     }
  451. var
  452.   DirWin: integer;
  453.   Mask: DirStr;
  454.   Path: PathStr;
  455.   StartDir: PathStr;
  456.   Completed: boolean;
  457.  
  458.    procedure SetFields;
  459.    {}
  460.    begin
  461.       ActivatePrivateForm;
  462.       AssignHindHook(DirHindHook);
  463.       AssignLeaveFieldHook(DirLeaveHook);
  464.       SetFormWindow(14,5,66,21,1);
  465.       WinSetTitle(FormWinNum,DirVars.StrPromptFileTitle);
  466.       WinSetType(FormWinNum,WMove);
  467.       WinSetShowNum(FormWinNum,false);
  468.       KwikAddField(1,3,2);    { file name }
  469.       KwikAddField(2,3,4);    { file list }
  470.       KwikAddField(3,21,4);   { directory list }
  471.       KwikAddField(4,3,12);   { file mask list }
  472.       KwikAddField(5,21,12);  { drive list }
  473.       KwikAddField(6,39,2);   { OK Button }
  474.       if @DirVars.PromptFileHelp = nil then
  475.          KwikAddLastField(7,39,4)   { Cancel Button }
  476.       else
  477.       begin
  478.          KwikAddField(7,39,4);        { Cancel Button }
  479.          AddHotkeyField(8,315,Stop9); { F1 }
  480.          KwikAddLastField(9,39,6);    { Help Button }
  481.       end;
  482.       with DirVars do
  483.       begin
  484.          ScrollField(1,ScrlFldVar,33,pred(sizeof(ScrlFldVar)));
  485.          FieldRules(1,AllowNull+EraseDefault,[NoChar],[NoChar]);
  486.          ListField(2,15,7,FileFldVar);
  487.          if (LoadWithFiles(FilLst,Path,LastMaskStr,DirVars.Attr) = 0) then
  488.             ListAssignStrLL(2,FilLst);
  489.          ListField(3,15,7,DirFldVar);
  490.          if (LoadWithDirectories(DirLst,Path) = 0) then
  491.             ListAssignStrLL(3,DirLst);
  492.          DropListField(4,15,TypeFldVar);
  493.          if DirVars.DefaultMask = '' then
  494.          begin
  495.             if (LoadAvailFileExtensions(TypLst,Path) = 0) then ;
  496.          end else
  497.          begin
  498.             DefaultMask := SetUpper(DefaultMask);
  499.             if (LoadFileMasks(TypLst,DefaultMask) = 0) then ;
  500.          end;
  501.          LastFld4Val := StrLLGetStr(TypLst,TypeFldVar);
  502.          ListAssignStrLL(4,TypLst);
  503.          DrvFldVar := CurrentDriveByte;
  504.          if (DrvFldVar >= 2) and IsPhantom then
  505.            dec(DrvFldVar);
  506.          DropListField(5,15,DrvFldVar);
  507.          if (LoadWithDrives(DrvLst) = 0) then
  508.          begin
  509.             DrvLst.ActiveNode := DrvFldVar;
  510.             ListAssignStrLL(5,DrvLst);
  511.             LastDrv := DrvLst.ActiveNode;
  512.          end;
  513.          ButtonDefaultField(6,OpenButStr,Stop1);
  514.          ButtonField(7,WinVars.CancelButStr,Escaped);
  515.          SetHK(6,OpenHK);
  516.          SetHK(7,WinVars.CancelHotkey);
  517.          if @DirVars.PromptFileHelp <> nil then
  518.          begin
  519.            ButtonField(9,WinVars.HelpButStr,Stop9);
  520.            SetHK(9,WinVars.HelpHotKey);
  521.          end;
  522.       end;
  523.    end; { SetFields }
  524.  
  525.    procedure InitFieldVars;
  526.    {}
  527.    begin
  528.       with DirVars do
  529.       begin
  530.          FileFldVar := 1;
  531.          DirFldVar := 1;
  532.          TypeFldVar := 1;
  533.          DrvFldVar := 1;
  534.       end;
  535.    end; { InitFieldVars }
  536.  
  537. begin
  538.    StartDir := CurrentPathStr;
  539.    Path := '';
  540.    Completed := false;
  541.    ParseDriveandMask(FullFileName, Path);
  542.    InitFieldVars;
  543.    SetFields;
  544.    MouseShow(true);
  545.    CurrFld := 1;
  546.    repeat
  547.       DisplayAllFields;
  548.       Action := EditForm(CurrFld);
  549.       case Action of
  550.          Finished,
  551.          Stop1:    { open }
  552.             with DirVars do
  553.             begin
  554.                ScrlFldVar := Strip('B',' ',ScrlFldVar);
  555.                if (CurrFld = 1) and
  556.                   { does not contain any wildcards }
  557.                   (pos('*',ScrlFldVar) = 0) and (pos('?',ScrlFldVar) = 0) then
  558.                begin
  559.                   if ScrlFldVar = '' then
  560.                      ScrlFldVar := LastMaskStr
  561.                   else
  562.                   begin
  563.                      if ExistsOnly then
  564.                      begin
  565.                         if (ValidFileName(FExpand(ScrlFldVar)) = 0) then
  566.                         begin
  567.                            Completed := true;
  568.                            PromptFile := FExpand(ScrlFldVar);
  569.                         end else
  570.                            PromptOK(DirVars.NoExistTitle,'^'+ScrlFldVar+DirVars.NoExistText);
  571.                      end
  572.                      else if (ValidFileName(ScrlFldVar) = 0) then
  573.                      begin
  574.                         PromptFile := FExpand(DirVars.ScrlFldVar);
  575.                         Completed := true;
  576.                      end
  577.                      else
  578.                      begin
  579.                         PromptFile := DirVars.ScrlFldVar;
  580.                         Completed := true;
  581.                      end;
  582.                   end;
  583.                end else
  584.                begin
  585.                   if (pos('*',ScrlFldVar) = 0) and (pos('?',ScrlFldVar) = 0) then
  586.                   begin
  587.                      if (CurrFld = 2) then
  588.                      begin
  589.                         PromptFile := FExpand(DirVars.ScrlFldVar);
  590.                         Completed := true;
  591.                      end;
  592.                   end else
  593.                   begin
  594.                      LastMaskStr := ScrlFldVar;
  595.                      if (LoadWithFiles(FilLst,LastDir,LastMaskStr,DirVars.Attr) = 0) then
  596.                         ListUpdateStrLL(2,FilLst);
  597.                   end;
  598.                end;
  599.             end;
  600.          Escaped:
  601.             begin
  602.                PromptFile := '';
  603.                Completed := true;
  604.             end;
  605.          Stop9:
  606.             begin
  607.                DirVars.PromptFileHelp;
  608.             end;
  609.       end; { case }
  610.    until Completed;
  611.    DisposeFields;
  612.    DisposePrivateForm;
  613.    {$I-}
  614.    chdir(StartDir);
  615.    {$I+}
  616.    if IOResult <> 0 then
  617.       DirSetError(4);
  618.    with DirVars do
  619.    begin
  620.       StrLLDestroy(DrvLst);
  621.       StrLLDestroy(TypLst);
  622.       StrLLDestroy(DirLst);
  623.       StrLLDestroy(FilLst);
  624.    End;
  625. end; { PromptFile }
  626.  
  627.                              {****************}
  628.                              {**  FileList  **}
  629.                              {****************}
  630.  
  631. procedure PopulateList;
  632. {}
  633. var
  634.    WrdCnt,
  635.    I, gResult: integer;
  636.    Mask: DirStr;
  637.    SrchRec: SearchRec;
  638.    DrvCh: char;
  639. begin
  640.    I := 1;
  641.    DLLDestroy;
  642.    WrdCnt := WordCnt(LastMaskStr);
  643.    while (WrdCnt > 0) and (I < succ(WrdCnt)) do
  644.    begin
  645.       Mask := ExtractWords(I,1,lastMaskStr);
  646.       findfirst(Mask,DirVars.Attr-Directory,SrchRec);
  647.       while DosError = 0 do
  648.       begin
  649.          if (SrchRec.Attr and Directory <> Directory) then
  650.          begin
  651.             gResult := DllAddStr(SrchRec.Name);
  652.             if (gResult <> 0) then
  653.             begin
  654.                {display a not enough message}
  655.                exit;
  656.             end;
  657.          end;
  658.          findnext(SrchRec);
  659.       end;
  660.       inc(I);
  661.    end;
  662.    if LinkVars.ActiveDLL^.TotalNodes = 0 then
  663.       gResult := DLLAddStr(LinkVars.NoFilesFound)
  664.    else if DirVars.SortByName then
  665.    begin
  666.       I := length(DirVars.SortingStr) + 6;
  667.       gResult := (HardVars.Width - I) div 2;
  668.       MkWin(gResult,10,gResult + pred(I),12,Tint[ListTitle],4);
  669.       WriteCenter(11,0,DirVars.SortingStr);
  670.       DLLSort(0,true);
  671.       RmWin;
  672.    end;
  673.    if DirVars.AllowDirChange then {add all the directories}
  674.    begin
  675.       findfirst('*.*',Directory,SrchRec);
  676.       while DosError = 0 do
  677.       begin
  678.          if (SrchRec.Attr and Directory = Directory) then
  679.          begin
  680.             if (SrchRec.Name = '.') then
  681.             begin
  682.                if DirVars.RootnameStr <> '' then
  683.                   gResult := DllAddStr(DirVars.RootNameStr)
  684.                else
  685.                   gResult := -1;    {hack}
  686.             end
  687.             else
  688.                gResult := DllAddStr(SrchRec.Name);
  689.             if (gResult > 0) then
  690.             begin
  691.                {display a not enough message}
  692.                exit;
  693.             end
  694.             else if (gResult = 0) then
  695.             begin
  696.                DLLSetBit(LinkVars.ActiveDLL^.EndNodePtr,1,true);
  697.                DLLSetBit(LinkVars.ActiveDLL^.EndNodePtr,2,true);  {don't allow dirs to be tagged}
  698.             end;
  699.          end;
  700.          findnext(SrchRec);
  701.       end;
  702.    end;
  703.    if DirVars.AllowDrvChange then {add all the drives}
  704.    begin
  705.       for I := 1 to 26 do
  706.       begin
  707.          DrvCh := DriveChar(I);
  708.          if DriveExists(DrvCh) then
  709.          begin
  710.             gResult := DLLAddStr('[ -'+DrvCh+'- ]');
  711.             if gResult <> 0 then
  712.             begin
  713.               {display a not enough message}
  714.               exit;
  715.             end;
  716.             DLLSetBit(LinkVars.ActiveDLL^.EndNodePtr,1,true);
  717.             DLLSetBit(LinkVars.ActiveDLL^.EndNodePtr,2,true);  {don't allow dirs to be tagged}
  718.          end;
  719.       end;
  720.    end;
  721. end; { PopulateList }
  722.  
  723. {$IFOPT F-}
  724.    {$DEFINE FOFF}
  725.    {$F+}
  726. {$ENDIF}
  727. procedure FileListHook(DirFormatPtr:ListCfgPtr);
  728. {}
  729. var
  730.    Fname: string[21];
  731.    Str: StrScreen;
  732.    DNP: DoubleNodePtr;
  733. begin
  734.    with DirFormatPtr^ do
  735.    begin
  736.       WriteAT(2,succ(Y2),Tint[DirListInfo],
  737.               Squeeze('R',SlashedDirectory(LastDir)+LastMaskStr,pred(X2-X1)));
  738.       DNP := DLLNodePtr(ActiveNode);
  739.       FName := DLLGetNodeStr(DNP,0,0);
  740.       if DLLGetBit(DNP,2) then  {directory or drive}
  741.       begin
  742.          if Fname = '..' then
  743.             Str := DirVars.ParentStr + ' '+ ParentDirectory(LastDir)
  744.          else if FName = DirVars.RootnameStr then
  745.             Str := DirVars.RootStr
  746.          else if copy(FName,1,3) <> '[ -' then
  747.             Str := DirVars.SubDirStr+' '+Fname
  748.          else
  749.             Str := DirVars.DriveStr + ' '+copy(FName,4,1)+':';
  750.       end
  751.       else if Fname = LinkVars.NoFilesFound then
  752.             Str := DirVars.NoFilesStr
  753.       else
  754.          Str := FileDetailsStr(FName,false);
  755.       WriteAT(2,Y2+2,Tint[DirListInfo],Squeeze('L',Str,pred(X2-X1)));
  756.    end;
  757. end; {FileListHook}
  758.  
  759. function DirSelectHook(ListdetailsPtr:ListCfgPtr):gAction;
  760. {}
  761. var
  762.    DNP: DoubleNodePtr;
  763.    Fname: string[21];
  764. begin
  765.    with KeyVars do
  766.    with ListdetailsPtr^ do
  767.    begin
  768.       if (LastKey = 600)
  769.       or (LastKey = 27) then
  770.          DirSelectHook := Escaped
  771.       else if ((LastKey = 540) and (LastX <> 0))  {user selected something}
  772.       or (LastKey = 13) then
  773.       begin
  774.          DNP := DLLNodePtr(ActiveNode);
  775.          FName := DLLGetNodeStr(DNP,0,0);
  776.          if DLLGetBit(DNP,2) then  {directory or drive}
  777.          begin
  778.             {$I-}
  779.             if Fname = DirVars.RootNameStr then
  780.                chdir('\')
  781.             else if copy(FName,1,3) = '[ -' then  {drive}
  782.                chdir(Fname[4]+':')
  783.             else
  784.                chdir(Fname);
  785.             {$I+}
  786.             if IoResult <> 0 then
  787.                DirSelectHook := None
  788.             else
  789.             begin
  790.                GetDir(0,LastDir);
  791.                PopulateList;
  792.                ActiveNode := 1;
  793.                FileListHook(ListdetailsPtr);
  794.                DirSelectHook := Refresh;
  795.             end;
  796.          end
  797.          else if Fname = LinkVars.NoFilesFound then
  798.             DirSelectHook := None
  799.          else
  800.             DirSelectHook := Finished;
  801.       end
  802.       else
  803.          DirSelectHook := None;
  804.    end
  805. end;  {DirSelectHook}
  806. {$IFDEF FOFF}
  807.    {$F-}
  808.    {$UNDEF FOFF}
  809. {$ENDIF}
  810.  
  811. function FileList(FullFilename:PathStr; Tit:StrScreen): StrScreen;
  812. {Displays matching files in a multi-column list}
  813. var
  814.    DirFormat: ListCfg;
  815.    StartDir: DirStr;
  816.  
  817.    procedure SetWindowDimensions;
  818.    {}
  819.    begin
  820.       with DirFormat do
  821.       with DirVars do
  822.       begin
  823.          WX1 := LX1;
  824.          WX2 := LX2;
  825.          WY1 := LY1;
  826.          WY2 := LY2;
  827.       end;
  828.    end; { SetWindowDimensions }
  829.  
  830. begin
  831.    initlistcfg(DirFormat);
  832.    ListAssignSelectHook(DirFormat,DirSelectHook);
  833.    with DirFormat do
  834.    begin
  835.       ColCount := 1;
  836.       ColWidth := 12 + length(ListVars.ListLeft) + length(ListVars.Listright);
  837.       if ColWidth = 12 then
  838.          inc(ColWidth);
  839.       AllowTwoColors := true;
  840.       WStyle := DirVars.LWinStyle;
  841.       BotGap := 2;
  842.    end;
  843.    SetWindowDimensions;
  844.    ListAssignHindHook(DirFormat,FileListHook);
  845.    with DirVars do
  846.    begin
  847.       if GoldMemAvail < sizeof(NameList^) then
  848.       begin
  849.          DirSetError(1);
  850.          FileList := '';
  851.       end
  852.       else
  853.       begin
  854.          StartDir := CurrentPathStr;
  855.          getmem(NameList,sizeof(NameList^));
  856.          ParseDriveandMask(Fullfilename,LastDir);
  857.          {$I-}
  858.          chdir(LastDir);
  859.          {$I+}
  860.          if IOResult <> 0 then
  861.             LastDir := StartDir;
  862.          getdir(0,LastDir);  {make sure the fully qualified name is loaded}
  863.          InitDLLStr(NameList^);
  864.          DLLSetActiveList(NameList^);
  865.          PopulateList;
  866.          ListAssignDLL(DirFormat,NameList^);
  867.          RunList(DirFormat,Tit);
  868.          if (DirFormat.LastKey = 27) or (DirFormat.LastKey = 600) then
  869.             FileList := ''
  870.          else
  871.             FileList := SlashedDirectory(LastDir)+DLLGetNodeStr(DLLNodePtr(DirFormat.ActiveNode),0,0);
  872.          DLLDestroy;
  873.          freemem(NameList,sizeof(NameList^));
  874.          {$I-}
  875.          chdir(StartDir);
  876.          {$I+}
  877.          if IOResult <> 0 then {oh well};
  878.       end;
  879.    end;
  880. end; {FileList}
  881.  
  882.                           {*********************}
  883.                           {**  Get Directory  **}
  884.                           {*********************}
  885.  
  886. procedure RefreshDesc;
  887. {}
  888. begin
  889.    WriteAT(3,CdirLine,Tint[IOWinBody],
  890.           Squeeze('R',SlashedDirectory(DirVars.SavedPath),40));
  891. end; { RefreshDesc }
  892.  
  893.  
  894.  
  895. {$IFOPT F-}
  896.    {$DEFINE FOFF}
  897.    {$F+}
  898. {$ENDIF}
  899.  
  900.  
  901. procedure GetDirHindHook(CurrentField:byte;var Refresh:byte);
  902. {}
  903. var Rfsh: byte;
  904.     LK: word;
  905.     Tmp: string;
  906.  
  907.  
  908.    procedure ProcessField1;
  909.    {}
  910.    begin
  911.       with DirVars do
  912.       begin
  913.          Tmp := StrLLGetStr(DirLst,DirFldVar);
  914.          if (Tmp <> LinkVars.NoDirectories) then
  915.          begin
  916.             delete(Tmp,length(tmp),1);    { deletes brackets }
  917.             delete(Tmp,1,1);
  918.             {$I-}
  919.             ChDir(Tmp);
  920.             {$I+}
  921.             if IOResult <> 0 then
  922.                exit
  923.             else
  924.             begin
  925.                SavedPath := CurrentPathStr;
  926.                if ( LoadWithDirectories(DirLst,SavedPath) = 0 ) then
  927.                begin
  928.                   ListUpdateStrLL(1,DirLst);
  929.                   Refresh := RefreshAll;
  930.                end;
  931.                RefreshDesc;
  932.             end;
  933.          end;
  934.       end;
  935.    end; { ProcessField1 }
  936.  
  937. begin
  938.    Rfsh := RefreshNone;
  939.    case CurrentField of
  940.       1: begin   { Directory List }
  941.             LK := ListLastKey(1);
  942.             if (LK = 13) or (LK = 540) then     {Enter or left double click}
  943.                ProcessField1;
  944.          end;
  945.       2: begin  { Drive List }
  946.             LK := ListLastKey(2);
  947.             if (LK = 13) or (LK = 540) then
  948.             with DirVars do
  949.             begin
  950.                if DrvFldVar <> SavedDrv then
  951.                begin
  952.                   SetCurrentDriveTo(DriveChar(RealDriveID(DrvFldVar)));
  953.                   SavedPath := CurrentPathStr;
  954.                   if ( LoadWithDirectories(DirLst,SavedPath) = 0 ) then
  955.                   begin
  956.                      SavedDrv := DrvFldVar;
  957.                      ListUpdateStrLL(1,DirLst);
  958.                      ProcessField1;
  959.                   end else
  960.                   begin
  961.                      Tmp := NotReadyMsgA + DriveChar(RealDriveID(DrvFldVar)) +':|' + NotReadyMsgB;
  962.                      repeat
  963.                          if PromptOKCancel(NotReadyTitle,Tmp) = 2 then
  964.                          begin
  965.                             DrvFldVar := SavedDrv;
  966.                             DrvLst.ActiveNode := DrvFldVar;
  967.                             SetCurrentDriveTo(DriveChar(RealDriveID(SavedDrv)));
  968.                             DrvLst.ActiveNode := SavedDrv;
  969.                             SavedPath := CurrentPathStr;
  970.                             if LoadWithDirectories(DirLst,SavedPath) <> 0 then
  971.                                {too bad};
  972.                             ListUpdateStrLL(1,DirLst);
  973.                             Refresh := RefreshCurrent;
  974.                             exit;
  975.                          end;
  976.                      until LoadWithDirectories(DirLst,SavedPath) = 0;
  977.                      ListUpdateStrLL(1,DirLst)
  978.                   end;
  979.                   RefreshDesc;
  980.                   Refresh := RefreshAll;
  981.                end;
  982.             end;
  983.          end;
  984.    end; { case }
  985. end;  { GetDirHindHook }
  986.  
  987. {$IFDEF FOFF}
  988.    {$F-}
  989.    {$UNDEF FOFF}
  990. {$ENDIF}
  991.  
  992. function PromptDir(FullFilename:PathStr;Cmt:StrScreen): StrScreen;
  993. {}
  994. var Path: PathStr;
  995.     LastDrv, I: byte;
  996.     CmtOn: boolean;
  997.  
  998.    procedure SetFields;
  999.    {}
  1000.    begin
  1001.       CmtOn := Cmt <> '';
  1002.       ActivatePrivateForm;
  1003.       AssignHindHook(GetDirHindHook);
  1004.       SetFormWindow(19,6,61,18+ord(CmtOn)*2,1);
  1005.       WinSetTitle(FormWinNum,DirVars.StrPromptDirTitle);
  1006.       WinSetType(FormWinNum,WMove);
  1007.       WinSetShowNum(FormWinNum,false);
  1008.       WinDisplay(FormWinNum);
  1009.       if CmtOn then
  1010.          WriteHi(3,2,Tint[PromptHiCmt],Tint[PromptNormalCmt],Cmt);
  1011.       CDirLine := 11+ord(CmtOn)*2;
  1012.       RefreshDesc;
  1013.       KwikAddField(1,3,3+ord(CmtOn)*2);        { directory list }
  1014.       KwikAddField(2,19,3+ord(CmtOn)*2);       { drive list }
  1015.       KwikAddField(3,30,3+ord(CmtOn)*2);       { OK Button }
  1016.       if @DirVars.PromptFileHelp = nil then
  1017.          KwikAddLastField(4,30,5+ord(CmtOn)*2)   { Cancel Button }
  1018.       else
  1019.       begin
  1020.          KwikAddField(4,30,5+ord(CmtOn)*2);      { Cancel Button }
  1021.          KwikAddLastField(5,30,7+ord(CmtOn)*2);  { Help Button }
  1022.       end;
  1023.       with DirVars do
  1024.       begin
  1025.          ListField(1,15,7,DirFldVar);
  1026.          SetLabel(1,LabelTop,LabelTop,'Directories');
  1027.          if (LoadWithDirectories(DirLst,FullFileName) = 0) then
  1028.          begin
  1029.             ListAssignStrLL(1,DirLst);
  1030.             SavedDir := 1;
  1031.          end else
  1032.             DirSetError(2);
  1033.          DrvFldVar := SavedDrv;
  1034.          ListField(2,8,7,DrvFldVar);
  1035.          SetLabel(2, LabelTOp, LabelTop,'Drives');
  1036.          if (LoadWithDrives(DrvLst) = 0) then
  1037.             ListAssignStrLL(2,DrvLst);
  1038.          ButtonField(3,WinVars.OKButStr,Finished);
  1039.          ButtonField(4,WinVars.CancelButStr,Escaped);
  1040.          SetHK(3,WinVars.OKHotKey);
  1041.          SetHK(4,WinVars.CancelHotKey);
  1042.          if @DirVars.PromptFileHelp <> nil then
  1043.          begin
  1044.             ButtonField(5,WinVars.HelpButStr,Stop9);
  1045.             SetHK(5,WinVars.HelpHotKey);
  1046.          end;
  1047.       end;
  1048.    end; { SetFields }
  1049.  
  1050. begin
  1051.    with DirVars do
  1052.    begin
  1053.       SavedDrv := CurrentDriveByte;
  1054.       dec(SavedDrv,ord((SavedDrv <> 1) and IsPhantom));
  1055.       StrLLInit(DrvLst);
  1056.       StrLLInit(DirLst);
  1057.       StartPathStr := CurrentPathStr;
  1058.       if FullFileName = '' then
  1059.          FullFileName := StartPathStr;
  1060.       SavedPath := FullFileName;
  1061.       SetFields;
  1062.       repeat
  1063.          LastAction := EditForm(1);
  1064.          case LastAction of
  1065.            Stop1: begin {chdir}
  1066.              {!!}
  1067.            end;
  1068.            Stop9: DirVars.PromptFileHelp;
  1069.          end;
  1070.       until LastAction in [Finished,Escaped];
  1071.       if LastAction = Finished then
  1072.          PromptDir := SavedPath
  1073.       else
  1074.          PromptDir := '';
  1075.       if not SetCurrentPath(StartPathStr) then  { set path to original }
  1076.          DirSetError(3);
  1077.       DisposeFields;
  1078.       DisposePrivateForm;
  1079.       StrLLDestroy(DrvLst);
  1080.       StrLLDestroy(DirLst);
  1081.    end;
  1082. end;  { PromptDir }
  1083.  
  1084.                              {****************}
  1085.                              {**  TagFiles  **}
  1086.                              {****************}
  1087.  
  1088.               {*********************************************}
  1089.               {**  U N I T   I N I T I A L I Z A T I O N  **}
  1090.               {*********************************************}
  1091.  
  1092. procedure DirDefaultSettings;
  1093. {}
  1094. begin
  1095.    with DirVars do
  1096.    begin
  1097.       Attr := anyfile - Hidden - Directory - SysFile - VolumeID;
  1098.       AllowDirChange := true;
  1099.       AllowDrvChange := true;
  1100.       SortByName := false;
  1101.       InputField := '';
  1102.       DefaultMask := '';
  1103.       LWinStyle := 7;
  1104.       LX1 := 18;
  1105.       LY1 := 5;
  1106.       LX2 := 64;
  1107.       LY2 := 19;
  1108.       ExistsOnly := false;
  1109.    end;
  1110. end; { DirDefaultSettings }
  1111.  
  1112. procedure GOLDDIRInit;
  1113. {}
  1114. begin
  1115.    with DirVars do
  1116.    begin
  1117.       LastECode := 0;
  1118.       ScrlFldVar := '';
  1119.       StrLLInit(DrvLst);
  1120.       StrLLInit(TypLst);
  1121.       StrLLInit(DirLst);
  1122.       StrLLInit(FilLst);
  1123.       LastAction := None;
  1124.       DirFldVar := 1;
  1125.       DrvFldVar := 1;
  1126.       SavedDir := 0;
  1127.       EMsgFunc := DirEMsg;
  1128.       PromptFileHelp := NoRemoveDirhelpHook;;
  1129.       StrPromptFileTitle := ' Pick a File ';
  1130.       StrPromptDirTitle := ' Change directory ';
  1131.       OpenButStr := '  ~O~pen  ';
  1132.       OpenHK := 280;
  1133.       NotReadyTitle := 'Drive not ready!';
  1134.       NotReadyMsgA := 'Cannot read drive ';
  1135.       NotReadyMsgB := 'Please insert a disk or select Cancel';
  1136.       NoExistTitle := ' INVALID ';
  1137.       NoExistText := '||^Not a valid path or file name';
  1138.       ParentStr := 'Parent directory';
  1139.       SubDirStr := 'Sub directory';
  1140.       RootStr := 'Root directory';
  1141.       NoFilesStr := 'No files found';
  1142.       RootNameStr := '\ (root)';
  1143.       DriveStr := 'Drive';
  1144.       SortingStr := 'Sorting files...';
  1145.    end;
  1146.    DirDefaultSettings;
  1147. end; {GOLDDIRInit}
  1148.  
  1149. {$IFDEF TTT5} { allows backward compatibility to TTT5 }
  1150.  
  1151. function Display_Directory(DIRFULLFileName: StrScreen;var Retcode:integer): StrScreen;
  1152. {included for TTT5 compatibility}
  1153. begin
  1154.    Display_Directory := PromptFile(DIRFULLFileName);
  1155.    RetCode := DirVars.LastECode;
  1156. end;
  1157.  
  1158. {$ENDIF}
  1159.  
  1160. begin
  1161.    GOLDDIRInit;
  1162. end.
  1163.